home *** CD-ROM | disk | FTP | other *** search
Modula Implementation | 1993-12-23 | 19.9 KB | 742 lines |
- IMPLEMENTATION MODULE DosSupport;
- __IMP_SWITCHES__
- #ifdef HM2
- #ifdef __LONG_WHOLE__
- (*$!i+: Modul muss mit $i- uebersetzt werden! *)
- (*$!w+: Modul muss mit $w- uebersetzt werden! *)
- #else
- (*$!i-: Modul muss mit $i+ uebersetzt werden! *)
- (*$!w-: Modul muss mit $w+ uebersetzt werden! *)
- #endif
- #endif
- (*****************************************************************************)
- (* "UnixToDos()" basiert auf der MiNTLIB von Eric R. Smith und anderen *)
- (* --------------------------------------------------------------------------*)
- (* 05-Dez-93, Holger Kleinschmidt *)
- (*****************************************************************************)
-
- VAL_INTRINSIC
- CAST_IMPORT
-
- FROM SYSTEM IMPORT
- (* TYPE *) ADDRESS,
- (* PROC *) ADR;
-
- FROM PORTAB IMPORT
- (* CONST*) NULL,
- (* TYPE *) SIGNEDWORD, SIGNEDLONG, UNSIGNEDWORD, WORDSET;
-
- FROM OSCALLS IMPORT
- (* PROC *) Dgetdrv, Dgetcwd, Dgetpath, Fgetdta, Fsetdta, Fsfirst, Fsnext,
- Fseek, Fforce;
-
- FROM MEMBLK IMPORT
- (* PROC *) memalloc, memdealloc;
-
- FROM ctype IMPORT
- (* PROC *) tolower, toupper, isalpha, todigit, tocard;
-
- FROM cstr IMPORT
- (* PROC *) AssignCToM2, AssignM2ToC, strrchr, strcmp, strncmp, strncpy;
-
- FROM pSTRING IMPORT
- (* PROC *) COPY, ASSIGN, APPEND, DELETE, EQUAL, EQUALN, UPPER, TOKEN,
- RPOSCHR;
-
- FROM types IMPORT
- (* CONST*) EOS, PATHMAX, DDIRSEP, XDIRSEP, DDRVPOSTFIX, XDEVPREFIX, SUFFIXSEP,
- (* TYPE *) sizeT, ExtName, PathName, StrPtr, StrRange;
-
- IMPORT e;
-
- FROM cmdline IMPORT
- (* PROC *) getenv, GetEnvVar;
-
- FROM DosSystem IMPORT
- (* PROC *) MiNTVersion;
-
- (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
-
- CONST
- EOKL = LIC(0);
- #if no_MIN_MAX
- MAXCARD = CAST(CARDINAL,-1);
- #else
- MAXCARD = MAX(CARDINAL);
- #endif
-
- VAR
- MiNT : CARDINAL;
-
- (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
-
- PROCEDURE isexec ( path : StrPtr;
- REF default : ARRAY OF CHAR;
- REF var : ARRAY OF CHAR ): BOOLEAN;
-
- VAR sAdr,dAdr : StrPtr;
- l1, l2 : CARDINAL;
- hasExt : BOOLEAN;
- tIdx : CARDINAL;
- ext : ExtName;
- token : ExtName;
- suffices : PathName;
-
- BEGIN
- sAdr := strrchr(path, SUFFIXSEP);
- dAdr := strrchr(path, DDIRSEP);
-
- IF DIFADR(sAdr, dAdr) <= VAL(SIGNEDLONG,0) THEN
- RETURN(FALSE);
- ELSE
- AssignCToM2(ADDADR(sAdr, 1), ext);
- END;
-
- IF NOT GetEnvVar(var, suffices) THEN
- ASSIGN(default, suffices);
- END;
-
- (* moeglicherweise ist die Nichtunterscheidung von Klein/Grossbuchstaben
- * falsch, keine Ahnung...
- *)
- UPPER(suffices);
- UPPER(ext);
-
- tIdx := 0; l1 := 0;
- WHILE TOKEN(suffices, ";,", tIdx, l1, l2, token) DO
- IF EQUAL(ext, token) THEN
- RETURN(TRUE);
- END;
- END;
- RETURN(FALSE);
- END isexec;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE IsExec ((* EIN/ -- *) path : StrPtr ): BOOLEAN;
- BEGIN
- RETURN(isexec(path, EXECSUFFIX, "SUFFIX"));
- END IsExec;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE IsGEMExec ((* EIN/ -- *) path : StrPtr ): BOOLEAN;
- BEGIN
- RETURN(isexec(path, GEMEXT, "GEMEXT"));
- END IsGEMExec;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE IsDosExec ((* EIN/ -- *) path : StrPtr ): BOOLEAN;
- BEGIN
- #if (defined __GEMDOS__)
- RETURN(isexec(path, TOSEXT, "TOSEXT"));
- #else
- RETURN(isexec(path, DOSEXT, "DOSEXT"));
- #endif
- END IsDosExec;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE prefixLen ((* EIN/ -- *) path : StrPtr ): UNSIGNEDWORD;
-
- VAR __REG__ i : UNSIGNEDWORD;
- __REG__ c : CHAR;
- __REG__ p : StrPtr;
-
- BEGIN
- i := 0;
- p := path;
- REPEAT
- c := p^[i];
- INC(i);
- UNTIL (c = 0C) OR (c = DDIRSEP) OR (c = XDIRSEP) OR (c = DDRVPOSTFIX);
- IF c = DDRVPOSTFIX THEN
- RETURN(i);
- ELSE
- RETURN(0);
- END;
- END prefixLen;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE IsDosDevice ((* EIN/ -- *) path : StrPtr ): BOOLEAN;
-
- VAR __REG__ i : UNSIGNEDWORD;
-
- BEGIN
- i := prefixLen(path);
- RETURN((i > 2) AND (path^[i] = 0C));
- END IsDosDevice;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE CompletePath ((* EIN/ -- *) path : StrPtr;
- (* EIN/ -- *) fSize : StrRange;
- (* -- /AUS *) full : StrPtr;
- (* -- /AUS *) VAR fLen : INTEGER;
- (* -- /AUS *) VAR err : INTEGER ): BOOLEAN;
-
- VAR __REG__ drv : CARDINAL;
- __REG__ pIdx : UNSIGNEDWORD;
- __REG__ fIdx : UNSIGNEDWORD;
- __REG__ f : StrPtr;
- __REG__ p : StrPtr;
-
- BEGIN
- f := full;
- p := path;
- IF fSize < 4 THEN
- (* weniger als drei Zeichen + Nullbyte Platz *)
- err := e.eRANGE;
- RETURN(FALSE);
- END;
- IF (p^[0] = 0C) OR (p^[1] <> DDRVPOSTFIX) THEN
- (* Wenn kein Laufwerk angegeben ist, aktuelles Laufwerk ermitteln *)
- drv := Dgetdrv();
- f^[0] := todigit(drv + 10);
- pIdx := 0;
- INC(drv); (* fuer "Dgetpath" *)
- ELSE
- (* sonst angegebenes Laufwerk uebernehmen *)
- f^[0] := p^[0];
- pIdx := 2;
- drv := tocard(p^[0]) - 9; (* - 10 + 1 *)
- END;
- f^[1] := DDRVPOSTFIX;
-
- fIdx := 2;
- err := 0;
- IF p^[pIdx] <> DDIRSEP THEN
- (* relativer Pfad angegeben -> aktuellen Pfad ermitteln *)
- IF MiNT >= 96 THEN
- IF NOT Dgetcwd(ADDADR(f, 2), drv, fSize - 2, err) THEN
- RETURN(FALSE);
- END;
- ELSIF NOT Dgetpath(ADDADR(f, 2), drv, err) THEN
- RETURN(FALSE);
- END;
-
- WHILE f^[fIdx] <> 0C DO
- INC(fIdx);
- END;
- IF fIdx >= fSize THEN
- (* Ist wahrscheinlich schon zu spaet, da ueber <full> hinaus
- * geschrieben wurde, aber schaden kanns auch nicht.
- * (Kann nur auftreten, wenn 'Dgetpath' benutzt wurde)
- *)
- err := e.eRANGE;
- RETURN(FALSE);
- ELSE
- IF (fIdx = 2) OR (p^[pIdx] <> 0C) THEN
- (* Ein Wurzelverzeichnis muss mit einem Backslash gekennzeichnet
- * werden. Wenn ein (relativer) Pfad angegeben war, muss ebenfalls
- * ein Backslash zur Trennung eingefuegt werden.
- *)
- f^[fIdx] := DDIRSEP;
- INC(fIdx);
- END;
- END;
- END;
-
- WHILE (p^[pIdx] <> 0C) AND (fIdx < fSize) DO
- f^[fIdx] := p^[pIdx];
- INC(fIdx);
- INC(pIdx);
- END;
-
- IF fIdx >= fSize THEN
- err := e.eRANGE;
- RETURN(FALSE);
- ELSE
- f^[fIdx] := 0C;
- fLen := INT(fIdx);
- RETURN(TRUE);
- END;
- END CompletePath;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE DosToUnix ((* EIN/AUS *) dpath : StrPtr;
- (* EIN/ -- *) xSize : StrRange;
- (* -- /AUS *) xpath : StrPtr;
- (* -- /AUS *) VAR dlen : INTEGER;
- (* -- /AUS *) VAR xlen : INTEGER );
-
- VAR __REG__ dIdx : UNSIGNEDWORD;
- __REG__ dLen : UNSIGNEDWORD;
- __REG__ c : CHAR;
- __REG__ drv : CHAR;
- __REG__ d : StrPtr;
- __REG__ x : StrPtr;
- pre : UNSIGNEDWORD;
- pipe : BOOLEAN;
- device : BOOLEAN;
- tmp : ARRAY [0..14] OF CHAR;
- tmpLen : UNSIGNEDWORD;
-
- BEGIN
- d := dpath;
- x := xpath;
- dIdx := 0;
- WHILE d^[dIdx] <> 0C DO
- (* \ --> / und gegebenenfalls in Kleinbuchstaben wandeln *)
- c := d^[dIdx];
- IF c = DDIRSEP THEN
- c := XDIRSEP;
- ELSIF MiNT = 0 THEN
- c := tolower(c);
- END;
- d^[dIdx] := c;
- INC(dIdx);
- END;
-
- dLen := dIdx;
- dlen := VAL(INTEGER,dIdx);
- pre := prefixLen(d);
- drv := tolower(d^[0]);
-
- IF pre = 2 THEN
- (* Laufwerk, "x:" *)
- pipe := FALSE;
- device := FALSE;
- dIdx := 2;
- IF MiNT > 0 THEN
- IF drv = 'q' THEN
- (* <xpath>^ wird 3 Zeichen laenger als <dpath>^, wenn ein absoluter
- * Pfad angegeben ist, sonst 4 Zeichen.
- *)
- pipe := TRUE;
- ELSIF drv = 'v' THEN
- (* <xpath>^ wird 2 Zeichen laenger als <dpath>^, wenn ein absoluter
- * Pfad angegeben ist, sonst 3 Zeichen.
- *)
- device := TRUE;
- ELSIF drv = 'u' THEN
- c := d^[0];
- d^[0] := drv;
- tmp := "u:/pipeu:/dev";
- IF strncmp(CAST(StrPtr,ADR(tmp)), d, 7) = 0 THEN
- pipe := (dLen = 7) OR (d^[7] = XDIRSEP);
- IF pipe THEN
- (* <xpath>^ wird 2 Zeichen kuerzer als <dpath>^, wenn ein absoluter
- * Pfad angegeben ist, sonst 1 Zeichen.
- *)
- dIdx := 7;
- END;
- ELSIF strncmp(CAST(StrPtr,ADR(tmp[7])), d, 6) = 0 THEN
- device := (dLen = 6) OR (d^[6] = XDIRSEP);
- IF device THEN
- (* <xpath>^ wird 2 Zeichen kuerzer als <dpath>^, wenn ein absoluter
- * Pfad angegeben ist, sonst 1 Zeichen.
- *)
- dIdx := 6;
- END;
- ELSIF (dLen >= 4) AND (d^[2] = XDIRSEP)
- AND ((dLen = 4) OR (d^[4] = XDIRSEP))
- THEN
- (* "u:/x" oder "u:/x/..." *)
- drv := tolower(d^[3]);
- dIdx := 4;
- END;
- d^[0] := c;
- END;
- END; (* IF MiNT *)
-
- IF pipe THEN
- tmp := "/pipe";
- tmpLen := 5;
- ELSIF device THEN
- tmp := "/dev";
- tmpLen := 4;
- ELSE
- IF ROOTDIR = drv THEN
- IF dLen = dIdx THEN
- tmp := "/";
- tmpLen := 1;
- ELSE
- tmp := "";
- tmpLen := 0;
- END;
- ELSIF ROOTDIR = 'u' THEN
- tmp := "/@";
- tmp[1] := drv;
- tmpLen := 2;
- ELSE
- tmp := "/dev/@";
- tmp[5] := drv;
- tmpLen := 6;
- END;
- END; (* IF pipe *)
- IF (dIdx < dLen) AND (d^[dIdx] <> XDIRSEP) THEN
- tmp[tmpLen] := XDIRSEP;
- INC(tmpLen);
- END;
- ELSIF pre = 1 THEN
- (* duerfte nicht auftreten, ":..." *)
- tmp[0] := XDIRSEP;
- tmp[1] := EOS;
- tmpLen := 1;
- dIdx := 1;
- ELSE
- dIdx := 0; (* nichts vom "DOS"-Pfad loeschen *)
- IF pre > 2 THEN
- tmp := "con:";
- IF strcmp(CAST(StrPtr,ADR(tmp)), d) = 0 THEN
- AssignM2ToC("/dev/tty", xSize, x);
- xlen := 8;
- RETURN;
- ELSE
- tmp := "/dev/";
- tmpLen := 5;
- d^[pre-1] := EOS; (* den Doppelpunkt loeschen *)
- dLen := pre - 1; (* fuer die Berechnung von 'xlen' korr. *)
- END;
- ELSE (* pre = 0 *)
- tmp := "";
- tmpLen := 0;
- END;
- END; (* IF pre *)
-
- xlen := VAL(INTEGER,dLen - dIdx + tmpLen);
- AssignM2ToC(tmp, xSize, x);
- IF xSize > tmpLen THEN
- (* Den restlichen (umgewandelten) Dospfad anhaengen *)
- strncpy(CAST(StrPtr,ADDADR(x, tmpLen)),
- CAST(StrPtr,ADDADR(d, dIdx)),
- VAL(sizeT,xSize - tmpLen));
- END;
- END DosToUnix;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE UnixToDos ((* EIN/ -- *) VAR xpath : ARRAY OF CHAR;
- (* EIN/ -- *) xlen : CARDINAL;
- (* EIN/ -- *) dSize : StrRange;
- (* -- /AUS *) dpath : StrPtr;
- (* -- /AUS *) VAR dot : BOOLEAN;
- (* -- /AUS *) VAR done : BOOLEAN );
- (**)
- CONST TMPMAX = 13;
-
- VAR __REG__ xIdx : UNSIGNEDWORD;
- __REG__ xLen : UNSIGNEDWORD;
- __REG__ dIdx : UNSIGNEDWORD;
- __REG__ c : CHAR;
- __REG__ d : StrPtr;
- xOffs : UNSIGNEDWORD;
- tmp : ARRAY [0..TMPMAX] OF CHAR;
- root : BOOLEAN;
- replace : BOOLEAN;
- shift : BOOLEAN;
- stack : ADDRESS;
- bufP : StrPtr;
- res : INTEGER;
- buf : ARRAY [0..1] OF CHAR;
-
- BEGIN (* UnixToDos *)
- d := dpath;
- xOffs := 0;
- done := FALSE;
- root := FALSE;
- replace := FALSE;
- IF dSize = 0 THEN
- e.errno := e.ENAMETOOLONG;
- RETURN;
- END;
- xLen := VAL(UNSIGNEDWORD,xlen);
- IF xLen = 0 THEN
- e.errno := e.ENOENT;
- RETURN;
- END;
-
- ASSIGN(xpath, tmp);
- FOR dIdx := 0 TO TMPMAX DO
- IF tmp[dIdx] = DDIRSEP THEN
- tmp[dIdx] := XDIRSEP;
- END;
- END;
-
- (* Da bei "GEMDOS" die Eintraege "." und ".." im Hauptverzeichnis nicht
- * existieren, werden sie durch das Hauptverzeichnis ersetzt, falls mit
- * Sicherheit festgestellt werden kann, dass das Hauptverzeichnis gemeint ist.
- * Dies ist auch korrekt, wenn ein Dateisystem benutzt wird, dass diese
- * Eintraege hat, da sie dann auch aufs Hauptverzeichnis verweisen.
- *
- * Es gibt folgende Faelle:
- * - "/.", "/..", "/./xxx", "/../xxx" absoluter Pfad
- * hier kann sofort korrigiert werden.
- *
- * - ".", "..", "./xxx", "../xxx" relativer Pfad
- * hier muss zuerst festgestellt werden, ob das aktuelle Verzeichnis
- * das Hauptverzeichnis ist.
- *
- * - alle anderen Faelle (wenn "." oder ".." als Teil einer Pfadangabe
- * auftreten, auch wenn nur ein Laufwerk angegeben ist) werden hier
- * nicht korrigiert, da dies einen grossen Aufwand bedeutet, aber
- * seltener auftritt.
- *)
-
- c := tmp[0];
- IF c = '.' THEN
- IF xLen > 1 THEN
- c := tmp[1];
- END;
- IF (xLen = 1) OR (xLen = 2) AND (c = '.') THEN
- replace := TRUE;
- ELSIF (xLen > 1) AND ((c = XDIRSEP)
- OR (xLen > 2) AND (c = '.') AND (tmp[2] = XDIRSEP))
- THEN
- shift := TRUE;
- END;
- IF replace OR shift THEN
- (* Testen, ob das aktuelle Verzeichnis das Wurzelverzeichnis ist *)
- IF MiNT >= 96 THEN
- root := Dgetcwd(ADR(buf), 0, 2, res) AND (buf[0] = 0C);
- (* Wenn Dgetcwd nicht geklappt hat, war der Platz zu klein, d.h. das
- * aktuelle Verzeichnis kann nicht das Wurzelverzeichnis sein.
- *)
- ELSE
- memalloc(PATHMAX, stack, bufP);
- (* Ohne MiNT kann man nur hoffen, dass PATHMAX ausreicht... *)
- root := Dgetpath(bufP, 0, res) AND (bufP^[0] = 0C);
- memdealloc(stack);
- END;
- IF root AND shift THEN
- IF c = XDIRSEP THEN
- (* "./xxx" --> "/xxx" *)
- xOffs := 1;
- ELSE (* tmp[2] = XDIRSEP *)
- (* "../xxx" --> "/xxx" *)
- xOffs := 2;
- END;
- ELSE
- replace := FALSE;
- END;
- END;
- ELSIF (xLen > 1) AND (c = XDIRSEP) AND (tmp[1] = '.') THEN
- IF xLen > 2 THEN
- c := tmp[2];
- END;
- IF (xLen = 2) OR (xLen = 3) AND (c = '.') THEN
- replace := TRUE;
- ELSIF (xLen > 2) AND ((c = XDIRSEP)
- OR (xLen > 3) AND (c = '.') AND (tmp[3] = XDIRSEP))
- THEN
- IF c = XDIRSEP THEN
- (* "/./xxx" --> "/xxx" *)
- xOffs := 2;
- ELSE (* tmp[3] = XDIRSEP *)
- (* "/../xxx" --> "/xxx" *)
- xOffs := 3;
- END;
- END;
- END;
- IF replace THEN
- (* ".", "..", "/.", "/.." --> "/" *)
- xLen := 1;
- tmp[0] := XDIRSEP;
- tmp[1] := EOS;
- ELSIF xOffs > 0 THEN
- DELETE(0, xOffs, tmp);
- DEC(xLen, xOffs);
- END;
-
- dot := FALSE;
- dIdx := 0;
- xIdx := xOffs;
-
- IF EQUALN(5, XDEVPREFIX, tmp) THEN
- (* xpath = /dev/... *)
- IF (xLen > 5) AND isalpha(tmp[5]) AND ((xLen = 6) OR (tmp[6] = XDIRSEP)) THEN
- (* "GEMDOS"-Laufwerksbezeichner: /dev/A, /dev/A/..., /dev/A\... --> A:
- * <dpath>^ wird 4 Zeichen kuerzer als <xpath>.
- *)
- tmp[0] := tmp[5];
- tmp[1] := DDRVPOSTFIX;
- tmp[2] := EOS;
- dIdx := 2;
- INC(xIdx, 6);
- ELSIF MiNT > 0 THEN
- INC(xIdx, 5);
- (* Geraete sind bei MiNT ueber Laufwerk 'U' ansprechbar:
- * /dev/... --> U:\dev\...
- * <dpath>^ wird 2 Zeichen laenger als <xpath>.
- *)
- tmp := "u:\dev\\"; (* \\ wegen Praeprozessor... *)
- dIdx := 7;
- ELSE
- IF EQUAL("/dev/tty", tmp) THEN
- (* <dpath>^ wird 4 Zeichen kuerzer als <xpath> *)
- AssignM2ToC("con:", dSize, d);
- done := dSize > 4; (* incl. Nullbyte *)
- ELSE
- (* <dpath>^ wird 4 Zeichen kuerzer als <xpath>, falls <xpath>
- * nicht mit einem ':' abgechlossen ist, sonst 5 Zeichen.
- *)
- IF xpath[xOffs+xLen-1] <> DDRVPOSTFIX THEN
- dIdx := 1; (* Flag: ":" anfuegen *)
- END;
- DEC(xLen, 5);
- strncpy(d, CAST(StrPtr,ADR(xpath[xOffs+5])), VAL(sizeT,dSize)); (* /dev/ ueberspringen *)
- done := xLen + dIdx < dSize;
- IF done AND (dIdx = 1) THEN
- d^[xLen] := DDRVPOSTFIX;
- d^[xLen+1] := 0C;
- END;
- END;
- RETURN;
- END;
- ELSIF (MiNT > 0) AND EQUALN(6, "/pipe/", tmp) THEN
- INC(xIdx, 6);
- (* Pipes koennen ueber Laufwerk U: angesprochen werden:
- * /pipe/... --> U:\pipe\...
- * <dpath>^ wird 2 Zeichen laenger als <xpath>.
- *)
- tmp := "u:\pipe\\";
- dIdx := 8;
- ELSIF (tmp[0] = XDIRSEP) AND NOT root AND (ROOTDIR <> 0C) THEN
- (* <dpath>^ wird 2 Zeichen laenger als <xpath>. *)
- tmp[0] := ROOTDIR;
- tmp[1] := DDRVPOSTFIX;
- tmp[2] := EOS;
- dIdx := 2;
- END;
-
- INC(xLen, xOffs);
- IF (xLen - xIdx) + dIdx >= dSize THEN
- e.errno := e.ENAMETOOLONG;
- RETURN;
- END;
-
- AssignM2ToC(tmp, dIdx, d);
- WHILE xIdx < xLen DO
- c := xpath[xIdx];
- IF c = XDIRSEP THEN (* / --> \ *)
- c := DDIRSEP;
- END;
- d^[dIdx] := c;
- INC(xIdx);
- INC(dIdx);
- END;
- d^[dIdx] := 0C;
- done := TRUE;
-
- (* Die Zuweisung an CHAR-Variable steht hier nur, weil der nachfolgende
- * Ausdruck moeglicherweise zu komplex fuer den einen oder anderen
- * Compiler ist (-> TDI).
- *)
- IF dIdx > 1 THEN
- c := d^[dIdx-2];
- ELSE
- c := 0C;
- END;
- dot := (dIdx > 0)
- AND (d^[dIdx-1] = '.')
- AND ((dIdx = 1)
- OR (c = DDIRSEP)
- OR (c = DDRVPOSTFIX)
- OR (c = '.')
- AND ((dIdx = 2)
- OR (d^[dIdx-3] = DDIRSEP)
- OR (d^[dIdx-3] = DDRVPOSTFIX)));
- END UnixToDos;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE FindFirst ((* EIN/ -- *) path : StrPtr;
- (* EIN/ -- *) attr : FileAttribute;
- (* EIN/AUS *) VAR dta : DTA;
- (* -- /AUS *) VAR res : INTEGER ): BOOLEAN;
- (*T*)
- VAR olddta : ADDRESS;
- done : BOOLEAN;
-
- BEGIN
- olddta := Fgetdta();
- Fsetdta(ADR(dta));
- done := Fsfirst(path, attr, res);
- Fsetdta(olddta);
- RETURN(done);
- END FindFirst;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE FindNext ((* EIN/AUS *) VAR dta : DTA;
- (* -- /AUS *) VAR res : INTEGER ): BOOLEAN;
- (*T*)
- VAR olddta : ADDRESS;
- done : BOOLEAN;
-
- BEGIN
- olddta := Fgetdta();
- Fsetdta(ADR(dta));
- done := Fsnext(res);
- Fsetdta(olddta);
- RETURN(done);
- END FindNext;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE IsTerm ((* EIN/ -- *) h : INTEGER ): BOOLEAN;
- (*T*)
- VAR old : SIGNEDLONG;
- lres : SIGNEDLONG;
- done : BOOLEAN;
-
- BEGIN
- done := Fseek(0, h, 1, old);
- done := Fseek(1, h, 0, lres);
- done := Fseek(old, h, 0, old);
-
- RETURN(lres = VAL(SIGNEDLONG,0));
- END IsTerm;
-
- (*===========================================================================*)
-
- VAR xmode : StrPtr;
- i : StrRange;
- h : SIGNEDWORD;
- res : INTEGER;
- done : BOOLEAN;
- c : CHAR;
-
- BEGIN (* DosSupport *)
- INODE := 32 (* ?? *);
- ROOTDIR := 0C;
- BINIO := FALSE;
- xmode := getenv("UNIXMODE");
- IF xmode <> NULL THEN
- i := 0;
- c := xmode^[0];
- WHILE c <> 0C DO
- IF (c = 'r') AND (xmode^[i+1] <> 0C) THEN
- ROOTDIR := tolower(xmode^[i+1]);
- INC(i);
- ELSIF (c = '.') AND (xmode^[i+1] <> 0C) THEN
- INC(i);
- ELSIF c = 'b' THEN
- BINIO := TRUE;
- END;
- INC(i);
- c := xmode^[i];
- END;
- END;
-
- IF (getenv("STDERR") = NULL) AND IsTerm(2) THEN
- (* siehe Profibuch von 1992 *)
- done := Fforce(2, -1, res);
- END;
-
- MiNT := MiNTVersion();
- IF (ROOTDIR = 0C) AND (MiNT > 0) THEN
- IF Dgetdrv() = 20(*U*) THEN
- ROOTDIR := 'u';
- END;
- END;
-
- FOR h := MinHandle TO MaxHandle DO
- FD[h].ftype := unknown;
- END;
- END DosSupport.
-